home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / (A)G / (A)G11.ADF / Wordsearch / ws < prev   
Text File  |  1989-08-17  |  14KB  |  425 lines
  1.   ON BREAK GOSUB quit:BREAK ON
  2.   GOTO setup
  3. '==========================================================
  4. '== doboard ===============================================
  5. '==========================================================
  6. doboard:
  7.   LINE (146,21)-(489,137),2,bf
  8.   x=(80-2*wide)/2:y=10-high/2
  9.   LINE (8*(x-1)+2,8*(y-1)+5)-STEP(16*wide+2,8*(high+1)-4),0,bf
  10.   LINE (8*(x-1)+4,8*(y-1)+6)-STEP(16*wide-2,8*(high+1)-6),2,bf
  11.   LINE (8*(x-1)+6,8*(y-1)+7)-STEP(16*wide-6,8*(high+1)-8),0,bf
  12. '==========================================================
  13. '== get puzzle ============================================
  14. '==========================================================
  15. getpuzzle:
  16.   CALL buttonup
  17.   SOUND 800,.7,255:SOUND 1000,.5,255,1
  18.   maxlength=high-2
  19.   msgbox -1,24,2,3,"Setting up new puzzle, hang in there or click mouse to stop..."
  20. '== erase old puzzle ======================================
  21.   FOR i=1 TO high:puzzle$(i)=SPACE$(3*wide):NEXT
  22. '== get words =============================================
  23.   LINE (0,163)-STEP(630,16),2,bf
  24.   msgbox 31,22,2,3," Fitting word #    "
  25.   RANDOMIZE TIMER
  26.   count=1
  27. nextword:
  28.   LOCATE 22,47:PRINT USING "##";count
  29.   word$(count)=UCASE$(wordlist$(RND*vocabulary+1))
  30.   IF LEN(word$(count))>maxlength THEN nextword
  31.   FOR i=1 TO count-1
  32.     IF word$(count)=word$(i) THEN word$(count)=""
  33.   NEXT
  34.   IF word$(count)="" THEN nextword
  35.   SOUND count*300/words+150,.7,100:SOUND 1.5*(count*300/words+150),.5,100,1
  36. '== fit words into puzzle =================================
  37.   startime#=TIMER
  38. direction:
  39.   xdir=INT(3*RND-1):ydir=INT(3*RND-1)
  40.   IF xdir=0 AND ydir=0 THEN direction
  41. startplace:
  42.   IF TIMER>startime#+5 THEN nextword
  43.   wordx=INT(RND*wide+1):wordy=INT(RND*high+1)
  44.   place=1:startx=wordx:starty=wordy
  45. anotherletter:
  46.   IF count>1 AND MOUSE(0)>0 THEN   
  47.     IF toomany=0 THEN 
  48.       m=-1*(words=8)-2*(words=12)-3*(words=17)-4*(words=22)
  49.       toomany=words
  50.     END IF
  51.     MENU 2,m,1 
  52.     words=count-1
  53.     GOTO abort
  54.   END IF
  55.   msg$=MID$(puzzle$(wordy),3*(wordx),1)
  56.   IF msg$<>" " AND msg$<>MID$(word$(i),place,1) THEN startplace
  57.   place=place+1:wordx=xdir+wordx:wordy=ydir+wordy
  58.   IF wordx<1 OR wordx>wide OR wordy<1 OR wordy>high THEN startplace
  59.   IF place<=LEN(word$(i)) THEN anotherletter
  60.   FOR place=0 TO LEN(word$(i))-1
  61.     MID$(puzzle$(place*ydir+starty),3*(place*xdir+startx)-1,1)="*"
  62.     MID$(puzzle$(place*ydir+starty),3*(place*xdir+startx),1)=MID$(word$(i),place+1,1)
  63.   NEXT
  64. abort:
  65.   count=count+1:IF count<=words THEN nextword
  66. '== fill unused squares with random letters ===============
  67.   FOR i=1 TO high
  68.     FOR j=1 TO wide
  69.       IF MID$(puzzle$(i),3*j,1)=" " THEN MID$(puzzle$(i),3*j,1)=CHR$(INT(RND*25+66))
  70.     NEXT
  71.   NEXT
  72. '== sort words alphabetically =============================
  73.   LINE (7,31)-STEP(110,120),0,bf
  74.   LINE (512,31)-STEP(110,56),0,bf
  75.   COLOR 2,0
  76.   FOR i=1 TO words-1
  77.     FOR j=i+1 TO words
  78.       IF word$(i)>word$(j) THEN SWAP word$(i),word$(j)
  79.     NEXT
  80.     IF i<16 THEN LOCATE i+4,3 ELSE LOCATE i-11,66
  81.     PRINT word$(i):wordon(i)=0
  82.   NEXT
  83.   IF i<16 THEN LOCATE i+4,3 ELSE LOCATE i-11,66
  84.   PRINT word$(i):wordon(i)=0
  85. '== more screen set-up ====================================
  86.   msgbox -1,24,2,3," "
  87.   COLOR 2,0
  88.   FOR i=1 TO high
  89.     FOR j=1 TO wide
  90.       LOCATE i+y,x+j*2-1:PRINT MID$(puzzle$(i),3*j,1)
  91.     NEXT
  92.   NEXT
  93.   LINE (0,163)-(630,179),2,bf
  94.   msgbox 30,22,2,3,"  Time used =        "
  95.   startime#=TIMER
  96. '==========================================================
  97. '== puzzle loop ===========================================
  98. '==========================================================
  99. puzzleloop:
  100.   CALL buttonup
  101.   WHILE MOUSE(0)=0 AND mflag=0
  102.     COLOR 2,3:LOCATE 22,44:PRINT USING "###.#";TIMER-startime#
  103.     IF TIMER-startime#>999.9 THEN
  104.       SOUND 100,3,255:SOUND 98,3,255,1
  105.       msgbox -1,24,2,3,"I feel so sorry for you, I'm going to reset your score"
  106.       startime#=TIMER      
  107.     END IF
  108.   WEND
  109.   IF mflag=-1 THEN mflag=0:GOTO doboard
  110.   mousex=MOUSE(3):mousey=MOUSE(4)
  111.   IF mousey<5 AND mousex<10 THEN quit
  112.   IF mousex>7 AND mousex<117 THEN
  113.     IF mousey>31 AND mousey<151 THEN
  114.       i=(mousey-3)/8-3
  115.       IF i<=words THEN
  116.         wordon(i)=-1-wordon(i)      
  117.         IF wordon(i) THEN COLOR 1,0 ELSE COLOR 2,0
  118.         LOCATE i+4,3:PRINT word$(i)
  119.       END IF
  120.     END IF
  121.   END IF
  122.   IF mousex>512 AND mousex<622 THEN
  123.     IF mousey>31 AND mousey<87 THEN
  124.       i=(mousey-3)/8+12
  125.       IF i<=words THEN
  126.         wordon(i)=-1-wordon(i)      
  127.         IF wordon(i) THEN COLOR 1,0 ELSE COLOR 2,0
  128.         LOCATE i-11,66:PRINT word$(i)
  129.       END IF
  130.     END IF
  131.     IF mousey>91 AND mousey<107 THEN goodgrades
  132.     IF mousey>107 AND mousey<123 THEN getpuzzle
  133.     IF mousey>123 AND mousey<139 THEN GOSUB paper:GOTO puzzleloop
  134.     IF mousey>139 AND mousey<155 THEN show
  135.   END IF
  136.   letterx=INT((mousex/8-x)/2)+1:lettery=INT(mousey/8-y)+1
  137.   IF letterx<1 OR lettery<1 OR letterx>wide OR lettery>high THEN puzzleloop
  138.   SOUND 500,.5,150:SOUND 625,.3,150,1
  139.   IF MID$(puzzle$(lettery),3*letterx-2,1)=" " THEN
  140.     MID$(puzzle$(lettery),3*letterx-2,1)="*"
  141.     COLOR 3,0
  142.   ELSE
  143.     MID$(puzzle$(lettery),3*letterx-2,1)=" "
  144.     COLOR 2,0
  145.   END IF
  146.   LOCATE lettery+y,2*letterx+x-1:PRINT MID$(puzzle$(lettery),3*letterx,1)
  147.   GOTO puzzleloop
  148. '==========================================================
  149. '== grading the system ====================================
  150. '==========================================================
  151. goodgrades:
  152.   endtime#=TIMER-startime#
  153.   SOUND 1000,.7,255:SOUND 1250,.5,255,1
  154.   msgbox -1,22,2,3," "
  155.   msgbox -1,24,2,3,"OK, let's see how you did... "
  156.   right=0:wrong=0
  157.   FOR i=1 TO high
  158.     FOR j=1 TO wide
  159.       IF MID$(puzzle$(i),3*j-2,2)="  " THEN COLOR 2,0
  160.       IF MID$(puzzle$(i),3*j-2,2)="* " THEN wrong=wrong+1:COLOR 3,1
  161.       IF MID$(puzzle$(i),3*j-2,2)=" *" THEN wrong=wrong+1:COLOR 3,0
  162.       IF MID$(puzzle$(i),3*j-2,2)="**" THEN right=right+1:COLOR 1,0
  163.       LOCATE i+y,x+j*2-1:PRINT MID$(puzzle$(i),3*j,1)
  164.     NEXT
  165.   NEXT
  166.   COLOR 2,3:LINE (0,164)-STEP(630,16),2,bf
  167.   button 2,22,2,0,5:button 9,22,2,3,9:button 20,22,2,0,4
  168.   button 26,22,2,3,9:button 37,22,2,0,4:button 43,22,2,3,9
  169.   button 54,22,2,0,4:button 60,22,2,3,13:button 75,22,2,0,4
  170.   LOCATE 22,9:PRINT "Right:";:PRINT USING "###";right
  171.   LOCATE 22,26:PRINT "Wrong:";:PRINT USING "###";wrong
  172.   LOCATE 22,43:PRINT "Time:";:PRINT USING "####";endtime#
  173.   LOCATE 22,60:PRINT "Score:";:PRINT USING "#######";1000*right/(wrong+1)-INT(endtime#)
  174.   IF wrong=0 THEN
  175.     msgbox -1,24,2,3,"Perfect!   (Is somebody helping you?)"
  176.     FOR i=1 TO 150
  177.       SOUND 400+200*SIN(i/6),1,,0
  178.       SOUND 400+200*SIN(i/6)+2,1,,1
  179.     NEXT
  180.   END IF
  181.   msgbox -1,24,2,3,"Click mouse to continue"
  182.   CALL whoa
  183.   mousex=MOUSE(3):mousey=MOUSE(4)
  184.   IF mousex>500 AND mousex<612 THEN
  185.     IF mousey>123 AND mousey<139 THEN SOUND 640,.7,255:SOUND 800,.5,255,1:GOSUB paper:GOTO puzzleloop
  186.     IF mousey>139 AND mousey<155 THEN SOUND 512,.7,255:SOUND 640,.5,255,1:GOTO quit
  187.   END IF
  188.   msgbox -1,24,2,3,""
  189.   GOTO getpuzzle
  190. '==========================================================
  191. '== paper =================================================
  192. '==========================================================
  193. paper:
  194.   endtime#=TIMER-startime#
  195.   SOUND 640,.7,255:SOUND 800,.5,255,1
  196.   msgbox -1,24,2,3,"Position paper then click mouse to continue."
  197.   CALL whoa
  198.   msgbox -1,24,2,3,""
  199. gohere:
  200.   LPRINT:LPRINT
  201.   LPRINT TAB(19);STRING$(41,42)
  202.   LPRINT TAB(19);"*         W O R D   S E A R C H         *"
  203.   LPRINT TAB(19);"*  find the hidden words in the puzzle  *"
  204.   LPRINT TAB(19);STRING$(41,42)
  205.   LPRINT
  206.   FOR i=1 TO high
  207.     LPRINT TAB(5);
  208.     IF 2*i<=words THEN LPRINT word$(i);
  209.     LPRINT TAB(40-wide);
  210.     FOR j=1 TO wide
  211.       LPRINT MID$(puzzle$(i),3*j,1)" ";
  212.     NEXT
  213.     IF 2*i<=words+1 THEN LPRINT TAB(63);word$(i+INT(words/2));
  214.     LPRINT ""
  215.   NEXT
  216.   msgbox -1,24,2,3,"Click down here for formfeed, or anywhere else to continue."
  217.   CALL whoa:mousey=MOUSE(4):IF mousey>179 THEN LPRINT CHR$(12);
  218.   msgbox -1,24,2,3,""
  219.   startime#=TIMER-endtime#
  220.   GOTO puzzleloop
  221. '==========================================================
  222. '== deal with menu selection ==============================
  223. '==========================================================
  224. menu0:
  225.   m=MENU(0):IF m>1 THEN mflag=-1
  226.   ON m GOTO menu1,menu2,menu3
  227. menu1:
  228.   m=MENU(1):ON m GOTO newcolors,show,quit
  229. menu2:
  230.   IF toomany>0 THEN words=toomany:toomany=0
  231.   m=-1*(words=8)-2*(words=12)-3*(words=17)-4*(words=22)
  232.   MENU 2,m,1 
  233.   m=MENU(1):words=-8*(m=1)-12*(m=2)-17*(m=3)-22*(m=4)
  234.   MENU 2,m,2
  235.   RETURN
  236. menu3:
  237.   MENU 3,high/2-4,1
  238.   m=MENU(1):high=2*m+8:wide=4*m+9
  239.   MENU 3,m,2
  240.   RETURN
  241. '==========================================================
  242. newcolors:
  243.   docolors
  244.   RETURN
  245. slowquit:
  246.   msgbox -1,24,0,2,"SlowQuit...   Click mouse to exit"
  247.   SOUND 100,5,255,0:SOUND 50,5,255,1:whoa
  248. show:
  249.   listflag=-1
  250. quit:
  251.   MENU RESET
  252.   FOR i=0 TO WINDOW(6):PALETTE i,rgb(i,0)/16,rgb(i,1)/16,rgb(i,2)/16:NEXT
  253.   IF NOT debug THEN
  254.     FOR freq=1200 TO 100 STEP -10
  255.       SOUND freq,.3,255,0:SOUND 1.25*freq,.3,255,1
  256.     NEXT
  257.     WINDOW 9,,(236,89)-(236+160,89+7),0
  258.     COLOR 3,2:CLS:PRINT "    john everett":PRINT "PeopleLINK ID OHS303";
  259.     SOUND  200,50,255,0:SOUND  250,50,255,1
  260.     SOUND  300,50,255,2:SOUND  400,50,255,3
  261.   END IF
  262.   WINDOW CLOSE 2
  263.   IF NOT debug THEN quit!=TIMER+3:WHILE TIMER<quit!:WEND
  264.   WINDOW CLOSE 9
  265.   REM $ignore on
  266.   IF listflag THEN LIST
  267.   REM $ignore off
  268.   SOUND 1600,1,255,0:SOUND 2000,1,255,1
  269.   SOUND  100,2,255,0:SOUND  125,2,255,1
  270.   IF listflag THEN CLEAR ,25000:END
  271.   CLEAR ,25000
  272.   SYSTEM
  273. '==========================================================
  274. '== set-up ================================================
  275. '==========================================================
  276. setup:
  277.   CLEAR,25000:CLEAR,48000&
  278.   DEFINT a-z:debug=0:mousex=0:mousey=0
  279.   WINDOW CLOSE 1:WINDOW 2,"",,16
  280.   
  281.   COLOR 1,2:CLS
  282.   LINE (3,9)-STEP(120,148),0,bf
  283.   LINE (5,10)-STEP(116,146),2,bf
  284.   LINE (7,11)-STEP(112,144),0,bf
  285.   msgbox  3, 3,3,2,"HIDDEN WORDS"
  286.   
  287.   msgbox 22,2,2,1,"    "
  288.   msgbox 28,2,2,1,"  W O R D   S E A R C H  "
  289.   msgbox 55,2,2,1,"    "
  290.   
  291.   LINE (507,9)-STEP(120,148),0,bf
  292.   LINE (509,10)-STEP(116,146),2,bf
  293.   LINE (511,11)-STEP(112,144),0,bf
  294.   msgbox 66, 3,3,2," MORE WORDS "
  295.   msgbox 66,13,3,2,"CHECK PUZZLE"
  296.   msgbox 66,15,3,2," NEW PUZZLE "
  297.   msgbox 66,17,3,2,"PRINT PUZZLE"
  298.   msgbox 66,19,3,2," QUIT  GAME "
  299.   
  300.   msgbox 22,19,2,0," Select/Unselect letters with mouse. "
  301.  
  302.   DIM wordlist$(1400),word$(22),wordon(22),puzzle$(18),rgb(WINDOW(6),2)
  303.   high=12:wide=17:words=12
  304.  
  305.   temp&=PEEKL(PEEKL(PEEKL(WINDOW(7)+46)+48)+4)
  306.   FOR i=0 TO WINDOW(6)
  307.     msg$=RIGHT$("00"+HEX$(PEEKW(temp&+2*i)),3)
  308.     FOR j=1 TO 3:rgb(i,j-1)=VAL("&h"+MID$(msg$,j,1)):NEXT
  309.   NEXT
  310.  
  311.   MENU 1,0,1,"System"
  312.     MENU 1,1,1,"NewColors"
  313.     MENU 1,2,1,"List     "
  314.     MENU 1,3,1,"Quit     "
  315.   MENU 2,0,1,"# Words"
  316.     MENU 2,1,1,"    8   "
  317.     MENU 2,2,2,"   12   "
  318.     MENU 2,3,1,"   17   "
  319.     MENU 2,4,1,"   22   "
  320.   MENU 3,0,1,"Puzzle Size"
  321.     MENU 3,1,1,"   10 X 13   "
  322.     MENU 3,2,2,"   12 X 17   "
  323.     MENU 3,3,1,"   14 X 21   "
  324.   MENU 4,0,0,""
  325.  
  326.   msgbox -1,24,2,3,"  reading wordlist...  "
  327.   vocabulary=0
  328.   OPEN "I",#1,"wordlist"
  329.     WHILE NOT EOF(1)
  330.       vocabulary=vocabulary+1
  331.       INPUT #1,wordlist$(vocabulary)
  332.     WEND
  333.   CLOSE #1
  334.   vocabulary=vocabulary-1
  335.   ON MENU GOSUB menu0:MENU ON
  336.   GOTO doboard
  337.  
  338. SUB msgbox (x,y,pen,paper,msg$) STATIC
  339.   IF x<0 THEN
  340.     x=INT((WINDOW(2)/8-LEN(msg$))/2)+1
  341.     length=WINDOW(2)/8-2*x+2
  342.   ELSE
  343.     length=LEN(msg$)
  344.   END IF
  345.   IF y>0 AND msg$<>"" THEN
  346.     IF y>21 THEN             '22 or 24
  347.       LINE (0,8*(y-1)-5)-STEP(630,16),2,bf
  348.       IF msg$<>"" THEN
  349.         button 2,y,2,0,x-4
  350.         button x,y,pen,paper,length
  351.         button 83-x,y,2,0,x-4
  352.       END IF
  353.     ELSE
  354.       button x,y,pen,paper,length
  355.     END IF
  356.   END IF
  357.   COLOR pen,paper:LOCATE ABS(y),x:PRINT msg$;
  358. END SUB
  359.  
  360. SUB button (x,y,pen,paper,length) STATIC
  361.   LINE (8*x-15,8*y-12)-STEP(8*length+12,14),paper,bf
  362.   LINE (8*x-13,8*y-11)-STEP(8*length+8,12),pen,bf
  363.   LINE (8*x-11,8*y-10)-STEP(8*length+4,10),paper,bf
  364. END SUB
  365.  
  366. SUB buttonup STATIC
  367.   WHILE MOUSE(0)<>0:SLEEP:WEND
  368. END SUB
  369.  
  370. SUB whoa STATIC
  371.   CALL buttonup:WHILE MOUSE(0)=0 AND INKEY$="":SLEEP:WEND
  372. END SUB
  373.  
  374. SUB docolors STATIC
  375.   SHARED rgb()
  376.   WINDOW 8,"       Palette       ",(60,30)-(226,144),18,-1
  377.   FOR i=0 TO WINDOW(6)/4-1
  378.     FOR j=0 TO 3
  379.       LINE (24*(j+3)  ,10*i  )-STEP(23,9),4*i+j,bf
  380.       LINE (24*(j+3)+2,10*i+1)-STEP(19,7),0,bf
  381.       LINE (24*(j+3)+4,10*i+2)-STEP(15,5),4*i+j,bf
  382.       IF 4*i+j>WINDOW(6) THEN j=3
  383.     NEXT
  384.   NEXT
  385.   msgbox  2,14,0,1,"  RESET  "
  386.   msgbox 13,14,0,1,"  OKAY  ":COLOR 1,0
  387. colorloop:
  388.   temp&=PEEKL(PEEKL(PEEKL(WINDOW(7)+46)+48)+4)
  389.   msg$=RIGHT$("00"+HEX$(PEEKW(temp&+2*colr)),3)
  390.   LOCATE 12,1
  391.   FOR i=0 TO 2
  392.     c(i)=VAL("&h"+MID$(msg$,i+1,1))
  393.     LINE (24*i+2,0)-(24*i+20,74-5*c(i)),0,bf
  394.     LINE (24*i+2,75-5*c(i))-(24*i+20,80),1,bf
  395.     PRINT " "MID$(msg$,i+1,1)" ";
  396.   NEXT
  397.   PRINT "  color="colr;
  398.   i=MOUSE(0):i=0:WHILE i=0:i=MOUSE(0):SLEEP:WEND
  399.   IF MOUSE(3)>166 OR MOUSE(4)>114 THEN colorloop
  400.   IF MOUSE(3)>72 THEN
  401.     i=(MOUSE(3)-82)/24:j=(MOUSE(4)-5)/10
  402.     IF 4*j+i<=WINDOW(6) THEN colr=4*j+i
  403.   END IF
  404.   IF MOUSE(3)<71 AND MOUSE(4)<80 THEN
  405.     WHILE MOUSE(0)<>0
  406.       j=15-MOUSE(2)/5:i=(MOUSE(3)-10)/24
  407.       IF j=>0 AND j<16 THEN c(i)=j
  408.       PALETTE colr,c(0)/16,c(1)/16,c(2)/16
  409.       LINE (24*i+2,0)-(24*i+20,74-5*c(i)),0,bf
  410.       LINE (24*i+2,75-5*c(i))-(24*i+20,80),colr,bf
  411.       LOCATE 12,3*i+2:PRINT MID$("0123456789ABCDEF",c(i)+1,1);
  412.     WEND
  413.   END IF
  414.   IF MOUSE(4)<102 THEN colorloop
  415.   IF MOUSE(3)<88 THEN
  416.     FOR i=0 TO WINDOW(6)
  417.       PALETTE i,rgb(i,0)/16,rgb(i,1)/16,rgb(i,2)/16
  418.     NEXT
  419.     SOUND 800,1,255:SOUND 1000,1,255,1
  420.     GOTO colorloop
  421.   END IF
  422.   WINDOW CLOSE 8
  423. END SUB
  424.  
  425.